home *** CD-ROM | disk | FTP | other *** search
/ Deutsche Edition 1 / Deutsche Edition 1.iso / amok / 011-020 / amok11 / r.o.m. / m2sources / makemenu.mod < prev    next >
Text File  |  1993-11-04  |  6KB  |  204 lines
  1. IMPLEMENTATION MODULE MakeMenu;
  2. (*
  3.   Created:   1987
  4.   Changed:   1.8.88 by
  5.              Stefan Salewski
  6.              Stolper Weg 3
  7.              2160 Stade   West-Germany
  8.              Tel: 04141/61130
  9.              
  10.   Note: compiled with AMIGA Modula-2 System by AMSoft from 5.5.88
  11.    
  12.   This Module may be freely copied. But please
  13.   leave my name in. Thanks....Stefan  
  14. *)
  15.  
  16.   FROM Preference IMPORT CharSize;
  17.   FROM SYSTEM IMPORT ADR,ADDRESS,BYTE,BITSET,LONGSET;
  18.   FROM Graphics IMPORT jam1,jam2,DrawModeSet;
  19.   FROM Exec IMPORT CopyMem,MemReqs,MemReqSet;
  20.   FROM Intuition IMPORT MenuPtr,MenuItemPtr,MenuItemFlagSet,checkWidth,
  21.        commWidth,menuEnabled,MenuItemFlags,IntuiTextPtr,WindowPtr;
  22.   FROM MyRemember IMPORT AllocRemember,FreeRemember,RememberNodePtr;
  23. (*  TYPE
  24.     Menunummer=INTEGER[0..MaxAnzahlMenus-1];
  25.     Itemnummer=INTEGER[0..MaxAnzahlItems-1];
  26.     Subitemnummer=INTEGER[0..MaxAnzahlSubitems-1];
  27.     !!!!!!!Integer hat keine Wirkung,deshalb -1..  (CompilerFehler) !!!!!
  28.  *)
  29.   TYPE
  30.     Menunummer=[-1..MaxAnzahlMenus-1];
  31.     Itemnummer=[-1..MaxAnzahlItems-1];
  32.     Subitemnummer=[-1..MaxAnzahlSubitems-1];
  33.   VAR
  34.     charWidth,charHeight:INTEGER;
  35.     
  36. (*************************************************************************)
  37.   PROCEDURE InitMenu(VAR mRcs:ARRAY OF MenuRecord;VAR firstMenu:MenuPtr;
  38.                      VAR remKey:RememberNodePtr);
  39.     VAR
  40.       menuPtr1,menuPtr2:MenuPtr;
  41.       firstItemPtr:MenuItemPtr;
  42.       intuTextPtr:IntuiTextPtr;
  43.       j:Menunummer;
  44.     PROCEDURE InitItems(VAR firstItem:MenuItemPtr);
  45.       VAR(*InitItems*)
  46.         itemPtr1,itemPtr2,firstSubitemPtr:MenuItemPtr;
  47.         i:Itemnummer;
  48.       PROCEDURE InitSubitems(VAR firstSubitem:MenuItemPtr);
  49.         VAR
  50.           subItemPtr1,subItemPtr2:MenuItemPtr;
  51.           m:Subitemnummer;
  52.       BEGIN
  53.         IF mRcs[j].mItems[i].anzahlSubitems > 0 THEN
  54.           AllocRemember(remKey,subItemPtr1,SIZE(subItemPtr1^))
  55.         ELSE
  56.           subItemPtr1:=NIL
  57.         END;
  58.         firstSubitem:=subItemPtr1;
  59.         FOR m:=0 TO mRcs[j].mItems[i].anzahlSubitems-1 DO
  60.           IF m < mRcs[j].mItems[i].anzahlSubitems-1 THEN
  61.             AllocRemember(remKey,subItemPtr2,SIZE(subItemPtr2^));
  62.             subItemPtr1^.nextItem:=subItemPtr2
  63.           ELSE
  64.             subItemPtr1^.nextItem:=NIL
  65.           END;
  66.           WITH subItemPtr1^ DO
  67.             leftEdge:=ItemnamenLaenge*charWidth;
  68.             topEdge:=m*(charHeight+2);
  69.             width:=(SubitemnamenLaenge+1)*charWidth+checkWidth+commWidth;
  70.             height:=(charHeight+2);
  71.             flags:=MenuItemFlagSet{itemText,itemEnabled,checkIt,highComp};
  72.             IF m=0 THEN INCL(flags,checked);END;
  73.             mutualExclude:=LONGSET{0..31}-LONGSET{(m)};
  74.             AllocRemember(remKey,intuTextPtr,SIZE(intuTextPtr^));
  75.             itemFill:=intuTextPtr;
  76.             selectFill:=NIL;
  77.             command:=mRcs[j].mItems[i].subrecords[m].commandKey;
  78.             IF command#0C THEN
  79.               flags:=flags+MenuItemFlagSet{commSeq}
  80.             END;
  81.             subItem:=NIL;
  82.             nextSelect:=0;
  83.           END;
  84.           WITH intuTextPtr^ DO
  85.             frontPen:=0;
  86.             backPen:=1; 
  87.             drawMode:=jam2;
  88.             leftEdge:=checkWidth;
  89.             topEdge:=1;
  90.             iTextFont:=NIL;
  91.             nextText:=NIL;
  92.             AllocRemember(remKey,iText,SIZE(Subitemname));
  93.             CopyMem(ADR (mRcs[j].mItems[i].subrecords[m].subName),iText,
  94.                     SIZE(Subitemname));
  95.           END;
  96.           subItemPtr1:=subItemPtr2;
  97.         END;(*FOR*)
  98.       END InitSubitems;    
  99.          
  100.     BEGIN (*InitItems*)
  101.       IF mRcs[j].anzahlItems > 0 THEN
  102.         AllocRemember(remKey,itemPtr1,SIZE(itemPtr1^))
  103.       ELSE
  104.         itemPtr1:=NIL
  105.       END;
  106.       firstItem:=itemPtr1;
  107.       FOR i:=0 TO mRcs[j].anzahlItems-1 DO
  108.         InitSubitems(firstSubitemPtr);
  109.         WITH itemPtr1^ DO
  110.           IF i < mRcs[j].anzahlItems-1 THEN
  111.             AllocRemember(remKey,itemPtr2,SIZE(itemPtr2^));
  112.             nextItem:=itemPtr2
  113.           ELSE
  114.             nextItem:=NIL
  115.           END;
  116.           leftEdge:=0;
  117.           topEdge:=i*(charHeight+2);
  118.           width:=(ItemnamenLaenge+1)*charWidth+commWidth;
  119.           height:=(charHeight+2);
  120.           flags:=MenuItemFlagSet{itemText,itemEnabled,highComp};
  121.           mutualExclude:=LONGSET{};
  122.           AllocRemember(remKey,intuTextPtr,SIZE(intuTextPtr^));
  123.           itemFill:=intuTextPtr;
  124.           selectFill:=NIL; 
  125.           IF mRcs[j].mItems[i].anzahlSubitems=0 THEN
  126.             command:=mRcs[j].mItems[i].commandKey;
  127.             subItem:=NIL;
  128.             IF command#0C THEN
  129.               INCL(flags,commSeq)
  130.             END;
  131.           ELSE
  132.             subItem:= firstSubitemPtr;
  133.             command:=0C
  134.           END;
  135.           nextSelect:=0;
  136.         END;
  137.         WITH intuTextPtr^ DO
  138.           frontPen:=0;
  139.           backPen:=1; 
  140.           drawMode:=jam2;
  141.           leftEdge:=0;
  142.           topEdge:=1;
  143.           iTextFont:=NIL;
  144.           nextText:=NIL;
  145.           AllocRemember(remKey,iText,SIZE(Itemname));
  146.           CopyMem(ADR (mRcs[j].mItems[i].iname),iText,SIZE(Itemname));
  147.         END;
  148.         itemPtr1:=itemPtr2;
  149.       END;(*FOR*)
  150.     END InitItems;
  151.   BEGIN (* InitMenu *)
  152.     remKey:=NIL;
  153.     IF HIGH(mRcs) > -1 THEN
  154.       AllocRemember(remKey,menuPtr1,SIZE(menuPtr1^));
  155.       firstMenu:=menuPtr1
  156.     ELSE
  157.       firstMenu:=NIL
  158.     END;
  159.     FOR j:=0 TO HIGH(mRcs) DO
  160.       InitItems(firstItemPtr);
  161.       WITH menuPtr1^ DO
  162.         IF j < HIGH(mRcs) THEN
  163.         AllocRemember(remKey,menuPtr2,SIZE(menuPtr2^));
  164.           nextMenu:=menuPtr2
  165.         ELSE
  166.           nextMenu:=NIL
  167.         END;
  168.         leftEdge:=j*charWidth*MenunamenLaenge;
  169.         topEdge:=0;
  170.         width:=charWidth*MenunamenLaenge;
  171.         height:=charHeight+2;
  172.         flags:=BITSET{menuEnabled};
  173.         firstItem:=firstItemPtr;
  174.         AllocRemember(remKey,menuName,SIZE(Menuname));
  175.         CopyMem(ADR (mRcs[j].mname),menuName,SIZE(Menuname));
  176.       END;
  177.       menuPtr1:=menuPtr2;
  178.     END;
  179.   END InitMenu;
  180.   
  181.   PROCEDURE FreeMenu(VAR remKey:RememberNodePtr);
  182.   BEGIN
  183.     FreeRemember(remKey);
  184.   END FreeMenu;
  185.       
  186.   PROCEDURE MenuNum(code:CARDINAL):CARDINAL;
  187.   BEGIN
  188.     RETURN code MOD 32
  189.   END MenuNum; 
  190.   
  191.   PROCEDURE ItemNum(code:CARDINAL):CARDINAL;
  192.   BEGIN
  193.     RETURN (code DIV 32) MOD 64
  194.   END ItemNum;
  195.    
  196.   PROCEDURE SubNum(code:CARDINAL):CARDINAL;
  197.   BEGIN
  198.     RETURN ((code DIV 32) DIV 64) MOD 32
  199.   END SubNum;
  200.       
  201. BEGIN
  202.   CharSize(charWidth,charHeight);
  203. END MakeMenu.mod
  204.